home *** CD-ROM | disk | FTP | other *** search
/ EuroCD 3 / EuroCD 3.iso / Programming / SecalDemo / Projects / Examples / MandelDemo.scl < prev    next >
Text File  |  1998-06-24  |  4KB  |  195 lines
  1. /******************************************************************************\
  2. **  Mandelbrot demo for Secal                                                 **
  3. **  Requires Kickstart 2                                                      **
  4. \******************************************************************************/
  5.  
  6.  
  7. go main;
  8.  
  9.  
  10. #-------------------------------------------------------------------------------
  11.  
  12.  
  13. include "inc/libcalls/exec.inc";
  14. include "inc/libcalls/intuition.inc";
  15. include "inc/utility/tagitem.inc";
  16. include "inc/graphics/gfx.inc";
  17. include "inc/graphics/rastport.inc";
  18. include "inc/intuition/screens.inc";
  19.  
  20.  
  21. def SysBase=[4.w].ul;
  22.  
  23.  
  24. /******************************************************************************\
  25. ************                      M A I N                           ************
  26. \******************************************************************************/
  27.  
  28.  
  29. obj IntuitionBase:ulong;
  30.  
  31. obj myscr,myscrbmp:ulong;
  32. obj basex,basey:word;
  33.  
  34.  
  35. #-------------------------------------------------------------------------------
  36.  
  37.  
  38. main:
  39. call sysinit;
  40. if d0 then
  41.     call mandel;
  42.     while [$dff016] and $400 do;        # DIRTY CHECK FOR RIGHT MOUSE BUTTON
  43.     call sysdone;
  44. ;
  45.  
  46. d0.l:=0;
  47. rts;                                                            # MAIN
  48.  
  49.  
  50. #-------------------------------------------------------------------------------
  51.  
  52.  
  53. #                                                                    D0=SUCCESS
  54.  
  55. sysinit:
  56. OpenLibrary("intuition.library",37); IntuitionBase:=d0;
  57. if IntuitionBase then
  58.     OpenScreenTagList(0,@scrtags); myscr:=d0;
  59.     if myscr then
  60.  
  61.         a0:=myscr; myscrbmp:=Screen(a0).RastPort.BitMap;
  62.         basex:=Screen(a0).Width/2-188/2;
  63.         d0:=Screen(a0).Height-(Screen(a0).BarHeight+1);
  64.         d0:=d0/2+(Screen(a0).BarHeight+1); basey:=d0-188/2;        # 0,0 OFFSET
  65.  
  66.         d0:=-1; go end_sysinit;        # INIT SUCCESSFULL
  67.     ;
  68.  
  69.                                                         # OTHERWISE FAILED
  70.     CloseLibrary(IntuitionBase);
  71. ;
  72.  
  73. d0:=0;
  74.  
  75. end_sysinit:
  76. rts;                                                            # SYSINIT
  77.  
  78.  
  79.  
  80. scrtags:
  81. dc.l SA_Depth,5;
  82. dc.l SA_Title,"Secal Mandelbrot demo";
  83. dc.l SA_Colors,@scrcolors;
  84. dc.l SA_Pens,@scrpens;
  85. dc.l TAG_DONE;                            # TAGS FOR OUR SCREEN
  86.  
  87. scrcolors:
  88. dc 0,0,0,0,     1,3,3,3,     2,5,5,5,     3,0,0,0;
  89. dc 4,0,0,0,     5,2,0,0,     6,3,0,0,     7,4,0,0;
  90. dc 8,5,0,0,     9,6,0,0,     10,7,0,0,    11,8,0,0;
  91. dc 12,9,0,0,    13,$a,0,0,   14,$b,0,0,   15,$c,0,0;
  92. dc 16,$d,0,0,   17,$e,0,0,   18,$f,0,0,   19,$f,1,1;
  93. dc 20,$f,2,2,   21,$f,3,3,   22,$f,4,4,   23,$f,5,5;
  94. dc 24,$f,6,6,   25,$f,7,7,   26,$f,8,8,   27,$f,9,9;
  95. dc 28,$f,$a,$a, 29,$f,$b,$b, 30,$f,$c,$c, 31,$f,$d,$d;
  96. dc -1;                                            # COLORS OF THE SCREEN
  97.  
  98. scrpens:
  99. dc -1;                                            # TO MAKE IT "NEW LOOK"
  100.  
  101.  
  102.  
  103.  
  104.  
  105. sysdone:
  106. CloseScreen(myscr);                            # CLOSE SCREEN
  107. CloseLibrary(IntuitionBase);                # CLOSE INTUITION
  108. rts;                                                            # SYSDONE
  109.  
  110.  
  111. /******************************************************************************\
  112. ************                M A N D E L B R O T                     ************
  113. \******************************************************************************/
  114.  
  115.  
  116. mandel:
  117. push d2\d3\d4\d5;
  118.  
  119. d3:=$fc00;
  120. for d5:=187 downto 0 do
  121.     d2:=$fc00;
  122.     for d4:=0 upto 187 do
  123.  
  124.         d0:=d2; d1:=d3; call iter;                # ITERATION
  125.         a0:=4+d0; d0:=basex+d4; d1:=basey+d5; call plot;    # PLOT
  126.  
  127.         d2:=d2+1+$800/188;
  128.     ;                                                            # X LOOP
  129.     d3:=d3+1+$800/188;
  130. ;                                                                # Y LOOP
  131.  
  132. pop d2\d3\d4\d5;
  133. rts;                                                            # MANDEL
  134.  
  135.  
  136.  
  137.  
  138.  
  139. obj mi_count:word;
  140.  
  141.  
  142. # D0=X, D1=Y                                            D0=RESULT
  143.  
  144. iter:
  145. push d2\d3\d4\d5;
  146.  
  147. d4:=d0; d5:=d1;
  148.  
  149. mi_count:=-1;
  150. repeat
  151.     d2.l:=(d4*d4) asr 9; d3.l:=(d5*d5) asr 9;        # X2:=X*X, Y2:=Y*Y
  152.     d5.l:=(d4*d5) asr 8 and -2; d5:=d5+d1;        # Y:=2*X*Y+Y0
  153.     d4:=d0+d2-d3;                                    # X:=X2-Y2+X0
  154.  
  155.     mi_count:=mi_count+1;
  156. until mi_count=28 orif d2+d3>=$800;
  157. if mi_count=28 then mi_count:=0;;
  158.  
  159. d0:=mi_count;                                        # RESULT=ITERATIONS
  160.  
  161. pop d2\d3\d4\d5;
  162. rts;                                                            # ITER
  163.  
  164.  
  165.  
  166.  
  167.  
  168. # D0=X, D1=Y, A0.W=COLOR
  169.  
  170. plot:
  171. push d2;
  172. d2:=a0;
  173.  
  174. a0:=myscrbmp; d1.l:=d1.w*BitMap(a0).BytesPerRow;
  175. d1.l:=d1+d0.w>>3; d0:=7-d0 and 7;            # OFFSET AND BIT NUMBER
  176.  
  177. a0:=@BitMap(a0).Planes[0];
  178. a1:=[a0+]+d1;
  179. if d2 and 1 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
  180. a1:=[a0+]+d1;
  181. if d2 and 2 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
  182. a1:=[a0+]+d1;
  183. if d2 and 4 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
  184. a1:=[a0+]+d1;
  185. if d2 and 8 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
  186. a1:=[a0+]+d1;
  187. if d2 and 16 then [a1].b:=[a1] bset d0; else [a1].b:=[a1] bclr d0;;
  188.                                                                 # PROCESS EACH PLANE
  189. pop d2;
  190. rts;                                                            # PLOT
  191.  
  192.  
  193. #*******************************************************************************
  194.  
  195.